PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/win/vb/justify2.txt

Text File | 1993-01-31 | 5.3 KB | 123 lines

This is the main text file with the form load and command1_click() routines

The purpose of this routine is to extract text from a VB trext box and justify the text to both the left and right margins on a line by line basis.

The main form is a form big enough to hold a Text Box 5760 Twips wide by 4320 Twips high.
the form rewuires a Command Button called Command1. The MultiLine property of the text box should be set to TRUE

Sub Command1_Click ()
'What Happens When You Push The "Print Out Justify Text"

'Printer Setup Dialog Box Variables
   'PrintSet% = 5
   'PrinterDialog.Action = PrintSet%

'Note: the next routine to determine #lines and #characters/line
   'was drawn from Article Number: Q84555 of the VB knowledgebase


'Find out how many lines and characters per line
   'in TextBucket

   WM_USER = &H400
   EM_GETLINECOUNT = WM_USER + 10
   EM_GETLINE = WM_USER + 20
   Justify1.TextBucket.SetFocus
   Texthwnd% = GetFocus()
   NumLines% = SendMessage(Texthwnd%, EM_GETLINECOUNT, 0, 0&)

'Find out how many Twips left over after printing this line of text at
   'the specified FontName and FontSize
   Printer.FontName = "Lucida Bright"
   Printer.FontSize = 10

   For I% = 0 To NumLines% - 1
      X$ = Space$(80) 'Setup required empty line variables (indexed)
      CurrentChar$ = Space(1) 'Used to hold the current character

      NumChars% = SendMessage(Texthwnd%, EM_GETLINE, I%, X$)
      SpaceCount% = 0
      MakeUpWidth% = (RightPrintMargin - LeftPrintMargin) - (Printer.TextWidth(Trim$(X$)))
      NumChars% = Len(Trim$(X$)) 'Get number Of characters in this line

'Determine number of spaces in each line
   'That's where your going to spread the makeup width
      For j = 1 To NumChars%
         CurrentChar$ = Mid$(LTrim$(X$), j, 1)
         If CurrentChar$ = " " Then
            SpaceCount% = SpaceCount% + 1
         End If
      Next j

'Determine if the line requires makeup space
      If SpaceCount% = 0 Then
         MakeupSpace% = 0
      Else
         MakeupSpace% = (MakeUpWidth% / SpaceCount%) + Printer.TextWidth(" ")
      End If

      CurrentChar$ = ""
      Printer.CurrentX = LeftPrintMargin
      'Printer.CurrentY = TextBucket.Top

      For j = 1 To NumChars%
         CurrentChar$ = Mid$(LTrim$(X$), j, 1)

         If CurrentChar$ = " " Then
            If Printer.TextWidth(Trim$(X$)) > ((RightPrintMargin - LeftPrintMargin) * .8) Then
            'The .8 factor is somewhat arbitrary ... it is dependent upon text structure
               'If you chose the entered words carefully so as to have minimal gap between
               'the end of the last word and the right margin of the text box, this factor
               'can be raise to .85 or .90
               Printer.CurrentX = Printer.CurrentX + MakeupSpace%
               Printer.Print Trim$(CurrentChar$);
            Else
               Printer.Print " ";
            End If
         Else
            Printer.Print Trim$(CurrentChar$);
         End If

      Next
      Printer.CurrentY = Printer.CurrentY + Printer.TextHeight(CurrentChar$)
      Printer.CurrentX = LeftPrintMargin
   Next
   Printer.EndDoc
End
End Sub

Sub Form_Load ()
   Justify1.Left = LeftForm
   Justify1.Top = TopForm
   Justify1.Width = FormWidth
   Justify1.Height = FormHeight

   TextBucket.Top = TopPrintMargin
   TextBucket.Width = RightPrintMargin - LeftPrintMargin
   TextBucket.Height = 4320
   Command1.Left = LeftPrintMargin
   Command1.Top = TextBucket.Top + TextBucket.Height + 180
   Command1.Height = 720
   TextBucket.FontName = "Lucida Bright"
   TextBucket.FontSize = 10
End Sub

This is the '.BAS' file with constants, API calls etc

'GetFocus returns the handle of the window with the focus
Declare Function GetFocus% Lib "User" ()

'SendMessage sends a message to the specified window
   'Note: the following declare should be on one line
Declare Function SendMessage% Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal Iparam As Any)

'Set left & right print margin parameters
Global Const LeftForm = 1440
Global Const TopForm = 1440
Global Const FormWidth = 8640
Global Const FormHeight = 7200

Global Const LeftPrintMargin = 720
Global Const RightPrintMargin = 6480
Global Const TopPrintMargin = 720
                                                                                                                                                                                                                                                                                                                    Ç
  ╠                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                         
Ç
  ═
  ╧
  d  f  ┴  3  5  L  å  ê  ¡  └  µ  δ  -  p  r  t  ª  ╣  ╠  α    !  B  ]  £  ₧  µ    6  P  U  u  ╗  ■     >  U  ▒  ·  ⁿ  &  ^  |  ¼  ╤  ⁿ